home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lisp / qpaux.el < prev    next >
Encoding:
Text File  |  1992-05-26  |  2.7 KB  |  112 lines
  1. ;;; SCCS: @(#)89/11/20 qpaux.el    2.2
  2. ;;;            Quintus Prolog - GNU Emacs Interface
  3. ;;;                         Support Functions
  4. ;;;
  5. ;;;                Consolidated by Sitaram Muralidhar
  6. ;;;
  7. ;;;                   sitaram@quintus.com
  8. ;;;              Quintus Computer Systems, Inc.
  9. ;;;                  2 May 1989       
  10. ;;;
  11. ;;; This file defines functions that support the Quintus Prolog - GNU Emacs
  12. ;;; interface.
  13. ;;;
  14. ;;;                   Acknowledgements
  15. ;;;
  16. ;;; This interface was made possible by contributions from Fernando
  17. ;;; Pereira and various customers of Quintus Computer Systems, Inc.,
  18. ;;; based on code for Quintus's Unipress Emacs interface.
  19. ;;; 
  20.  
  21.  
  22.  
  23. (qprequire 'mlsupport)
  24.  
  25. (ml-defun
  26.     (random-time-number  tme ln
  27.     (setq tme (current-numeric-time))
  28.     (setq ln (length tme))
  29.     (ml-substr tme (- ln 3) ln)))
  30.  
  31.  
  32. ; ----------------------------------------------------------------------
  33. ; The "$scratch-file" is used for communication with Prolog.  It should 
  34. ; probably have a more random name to minimize collisions with other
  35. ; users with the same home directory
  36. ; ----------------------------------------------------------------------
  37.  
  38. ; ----------------------------------------------------------------------
  39.  
  40.  
  41. (ml-defun (crlf (insert 10)))
  42.  
  43.  
  44. (defun agglutinating-charp  (char)
  45.   (or (= char 36) (= char 38) (= char 42) (= char 43) (= char 45) ; |
  46.       (= char 46) (= char 47) (= char 58) (= char 60) (= char 61)
  47.       (= char 62) (= char 63) (= char 64) (= char 92) (= char 94)
  48.       (= char 96) (= char 126) (= char 35)))
  49.  
  50. (defun layout-char  (char)
  51.   (or (and (>= char 0)
  52.           (<= char 32)
  53.        )
  54.        (= char 127)
  55.     )
  56. )
  57.  
  58. (ml-defun
  59.     (dotimes n
  60.     (setq n (ml-arg 1))
  61.     (while (not (zerop (> n 0)))
  62.            (setq n (- n 1))
  63.            (ml-arg 2))))
  64.  
  65.  
  66. (ml-defun (bell-message
  67.        (ml-message (ml-arg 1))
  68.        (bell)))
  69.  
  70. ;----------------------------------------------------------------------------
  71. ; This routine will wink the cursor around the current region
  72. (ml-defun (wink-region
  73.     (ml-if (pos-visible-in-window-p)
  74.     (sit-for twiddle-interval)
  75.     )
  76.     (exchange-dot-and-mark)
  77.     (ml-if (pos-visible-in-window-p)
  78.     (sit-for twiddle-interval)
  79.     )
  80.     (exchange-dot-and-mark)
  81.     (nothing)
  82. ))
  83.  
  84. ;----------------------------------------------------------------------------
  85. ; The following routines are used to properly handle message display
  86. ;  for the routines which talk to the Emacs interface from Prolog
  87.  
  88. (defvar *qpmess-buffer* " ")
  89.  
  90. (defun &qp-message (message)
  91.   (setq *qpmess-buffer* message)
  92.     )
  93.  
  94. (defun display-any-messages ()
  95.   (if (not (string-equal *qpmess-buffer* ""))
  96.       (message *qpmess-buffer*)
  97.     )
  98.   (sit-for 0)
  99.   (&clear-message)
  100.   )
  101.  
  102. (defun &clear-message ()
  103.     (setq *qpmess-buffer* "")
  104.     )
  105.  
  106. (defun &no-message ()
  107.   (setq *qpmess-buffer* "")
  108.   )
  109.  
  110.  
  111.  
  112.